00100	;E -- DISPLAY EDITOR FOR STANFORD
00200	;Written by Frederick H.G. Wright II
00300	;with modifications by D. Poole, Art Samuel, and Stan Kugell.
00400	;The Essay program was contracted by John Mccarthy and written by Stan Kugell
00500	
00600	PRINTS /Type 0 to get ETV, 1 to get ESSAY, then <CTRL><META><LF>./
00700	ESSFLG←←.INSER TTY:
00800	
00900	IFE ESSFLG<TITLE ETV -- DISPLAY EDITOR FOR STANFORD↔SUBTTL FREDERICK H.G. WRIGHT II
01000	PRINTS /       You are assembling ETV, the Stanford Display Editor
01100	/
01200	PRINTS/	MAR.28,1975  E.29(P481) Apr.6 1975 E.31(P487)	Apr.7 1975 E.32(P487)
01300	APR 10 1975 E.33(P487)	APR 14 E.34
01400	E.32 contains code for TELLME but no automatic calling
01500	E.32 Reloaded on April 8 with minor corrections.
01600	E.33 With some automatic calling (checksum error and UFATAL calls) Apr. 10 1975.
01700	E.34 ALINE bug fixed Apr.14 1975
01800	E.35 Fix for file-directory disagreements. Apr. 18 1975
01900	/>
02000	
02100	IFN ESSFLG<TITLE ESSAY
02200	PRINTS /       You are assembling Essay.
02300	/>
02400	DEFINE ESSAY <IFN ESSFLG>
02500	DEFINE NOESS <IFE ESSFLG>
02600	
02700	COMMENT ⊗ TO PUT UP A NEW E WITH AN UPPER SEGMENT, USE THE COMMANDS:
02800	
02900	.LOA %SE%1<%2V%1B	;LOADS WITH SYMBOLS AND NNRAID IN THE UPPER SEGMENT
03000	.S 137			;RENAMES UPPER, WRITE PROTECTS AND SETS ITS PROTECTION CONSTANT
03100	.SSAVE SYS E		;BE SURE TO SSave (to keep the UPPER SEGMENT around)
03200	
03300	Early versions of E that were up for varying lengths of time:
03400	Nov. 6 1974. E.7        Nov. 8 1974. E.8        Nov.17 1974. E.10
03500	Nov.18 1974. E.10       Dec. 3 1974. E.12       Dec. 9 1974. E.15
03600	Dec.10 1974. E.16(P424) Dec.14 1974. E.17(P431) DEC.17 1974. E.18(P431)
03700	Dec.18 1974. E.19(P431) Jan.3 1975. E.20(P439   Jan.5,1975   E.21(P439)
03800	Jan.10,1975. E.22(P442) Jan 15,1975  E.23(P442) Mar.12,1975. E.26(P474)
03900	Mar.13,1975  E.27       Mar.17 1975  E.27(P477) Mar.19 1975  E.28(P477)
04000	
04100	DATA STRUCTURE.
04200		A page  of text is  represented in memory  as a theaded  list of
04300	items  each representing a  single line of  the text. Each  item in this
04400	representation contains four  words of header  information, the text  of
04500	the line in question and one trailer word.
04600		The first header word contains a TXTCOD, which for ordinary text
04700	is a 2 in the left half and the total number of words in the right half. 
04800	This word  is used by the free storage  management routines. It does not
04900	seem to be used by the text manipulation sections of the code.  The word
05000	count is duplicated in  the trailer word which is also  used only by the
05100	free storage routines. 
05200		The  second  header  word is  a  pointer word.    It  contains a
05300	backward pointer  in  the left  half  pointing to  the location  of  the
05400	pointer  word of  the previous  item  and in  the right  half  a forward
05500	pointer to  the location  of the  pointer  word of  the next  item.  The
05600	location of the pointer word for the first item is contained in the word
05700	at  PAGE and  the  backward pointer  for the  first item points  back to
05800	PAGE. The last item on the page points to the word BOTSTR and  this word
05900	points back to this last item and forward to itself.  When in the ATTACH
06000	mode,   the  location  ATTBUF points  to the pointer  word of  the first
06100	attached line and back to the pointer word of the last attached line.
06200		The third word contains  flag bits in the left  half identifying
06300	the type  of the line and two  9-bit bytes in the right  half. Flag bits
06400	which have been identified are:
06500		400000	 the line is a page mark.
06600		200000	 the line is ARRLIN (CURRENT to which the arrow points).
06700		100000	 the line is WINLIN (the first line on the window).
06800		040000   the line is an Essay reference (for the ESSAY version).
06900	The  first byte  in  the right  half  contains the  total  count of  the
07000	characters as the line is stored on the disk, where a TAB symbol counts
07100	1 and the terminating CR and LF are counted.
07200	The  second byte  contains  the  count of  the  characters as  they  are
07300	displayed where a TAB is counted as the number of spaces it produces and
07400	the terminating CR and LF are not counted. 
07500	
07600		The fourth word is the serial number of the line as kept in the
07700	core. This number is changed every time that a change is made to the line
07800	so this number then bears no relationship to the position of the line on
07900	the page.
08000	
08100		The text occupies an integral number of words and is  padded out
08200	with nulls.
08300		The trailer  word contains the count  of the total words  in the
08400	item,   including  header   and  trailer  words.   This  duplicates  the
08500	information in the right half of the first header word.
08600	
08700	       TABs are handled in a pecular way. When a TAB occurs it is stored
08800	as  a TAB and  this is  followed by as  many spaces  as the TAB  in fact
08900	produces in the text and then by a terminating TAB.
09000	
09100	       end of comment ⊗
09200	
09300	NOLIT
09400	
09500	;Register	Most common usage
09600	
09700	F←0		;Flag bits
09800	A←1		;Argument value
09900	B←2		;CONTROL and META bits as stripped from command character.
10000	C←3		;Character
10100	D←4		;Dispatch table entry
10200	E←5		;Table location.
10300	G←6
10400	H←7
10500	I←10
10600	DSP←11		;Dispatch table location (CTAB most of the time).
10700	Q←14
10800	T←15
10900	TT←16
11000	P←17		;Always reserved as PDL pointer.
11100	
11200	DEFINE STOPJ
11300		{PUSHJ P,STOPJC	
11400		}	
11500	;Used to replace JRST 4,. and other fatal halts to inform ALS of trouble
11600	;STOPJ USED FOR JRST 4,. terminating with a JRST 4,. as usual
11700	;STOPC used for JRST 4,. WHEN ATTEMPT IS MADE TO CONTINUE
11800	
11900	IFNDEF PURESW<PURESW←←1>	;DEFAULT TO SHARABLE PURE UPPER SEGMENT
12000	IFNDEF DEBSW<DEBSW←←1>
12100	IFNDEF BOOKMD<BOOKMD←←1>
12200	;BOOKMD NON-ZERO PERMITS /B MODE FOR READING BOOKS.  0 DISABLES /B MODE.
12300	
12400	COPNUM←←3	;LOG OF # K OF CORE FOR TEMP COPY BUFFER
12500	SRSIZ←←40	;SIZE OF SEARCH STRING BUFFER
12600	LPDL←←69
12700	DPYBSZ←←=660*2
12800	
12900	DSKI←←1
13000	DSKO←←2
13100	DSKSP←←4	;Used for spooling file
13200	DSKCH←←5	;Used to write into bug file TELLME.001[E,ALS] , .002 etc.
13300	SWP←←3
13400	IFN BOOKMD, {
13500	RPGO←←4		;CHANNEL USED TO WRITE OUT .BKP FILE IN BKPSW MODE
13600	};END BOOKMD
13700	
13800	...←←0
13900	
14000	;Type of display (kept in cell called DPY)
14100	$TTY ←← 0	;Teletype kludge
14200	$DD  ←←	1	;Datadisk video type display
14300	$III ←←	2	;III Vector type display
     

00100	;RIGHT HALF FLAGS
00200	REDNLY←←1	;READ ONLY MODE
00300	COPY←←2		;NEED TO DO COPY (← OR →)
00400	DIROK←←4	;HAVE COMPLETE DIR
00500	UPDTXT←←10	;LINE 1 CHANGED - UPDATE DIR AT WRPAGE
00600	WRITE←←20	;SOMETHING CHANGED - NEED TO WRITE IT
00700	EOF←←40		;INPUT EOF DETECTED - DO ANOTHER LOOKUP (LOSING SYSTEM!)
00800	EDDIR←←100	;EDITING THE DIRECTORY PAGE
00900	ARG←←200	;ARG WAS TYPED TO COMMAND
01000	DSPSCR←←400	;REDISPLAY SCREEN
01100	DSPALL←←1000	;REDISPLAY WHOLE SCREEN
01200	FILLUZ←←2000	;EDITING NONSTANDARD FORMAT FILE
01300	REL←←4000	;RELATIVE ARG (+ OR -)
01400	NEG←←10000	;NEGATIVE ARG
01500	EDITM←←20000	;DISPATCH IS FROM LINE EDIT
01600	EDBRK←←40000	;(WITH EDITM) COMMAND TYPED IN MIDDLE OF LINE
01700	XPAGE←←100000	;WILL EXPAND FILE FOR PAGE
01800	UPDIR←←200000	;NON-TEXT CHANGE TO DIR
01900	ATTMOD←←400000	;IN ATTACH MODE
02000	
02100	;LEFT HALF FLAGS
02200	ENTRD←←1	;EDIT FILE HAS BEEN ENTERED
02300	CLRBF←←2	;CLEAR OBUF AFTER OUTPUT
02400	NOSHUF←←4	;DON'T SHUFFLE FREE STORAGE
02500	NOCHK←←10	;DON'T TRY TO CORE DOWN
02600	OFFEND←←20	;ARROW ON LINE N+1
02700	NULLIN←←40	;CURRENT LINE IS EMPTY
02800	ARRPG←←100	;ARROW POG IS SELECTED
02900	TF1←←200	;TEMP FLAG
03000	PMLIN←←400	;CURRENT LINE IS PAGE MARK
03100	OKF←←1000	;SHOULD TYPE "OK"
03200		;New flags added by ALS. May be represented by 3 bits if space gets tight.
03300	ALIN←←2000		;ALINE FLAG
03400	INDEN←←4000		;INDENT FLAG
03500	CEN←←10000		;CENTER FLAG
03600	JOINF←←20000		;JOIN FLAG
03700	ZATT←←40000		;To save ATTACH on a Z-EPSIL command.
03800	;	100000
03900	;	200000
04000	NGPUSE←←400000		;Network Graphic User
     

00100	;CHARACTER TABLE FLAGS
00200	NSPEC←←400000	;STANDARD SPECIAL CHAR (NULL OR RUBOUT) - MUST BE SIGN
00300	FSPC←200000	;FILE NAME DELIMITER
00400	LSPC←←100000	;SPECIAL CHAR IN LINE
00500	NUMF←←40000	;DIGIT
00600	DSPC←←20000	;SPECIAL DIR CHAR
00700	LETF←←10000	;LETTER - WITH LT2F => LOWER CASE
00800	LT2F←←4000	;ALONE => $%._
00900	SSP1←←2000	;TYPE 1 SPECIAL SEARCH STRING CHAR
01000	SSP2←←1000	;  "  2  " ...
01100	EDOK←←40	;RIGHTMOST OF 4 BITS (SHIFT BY CONTROL BITS) FOR LINE EDITOR LEGALITY
01200	
01300	;COMMAND DISPATCH FLAGS
01400	NOEDIT←←200000	;DISPATCH DIRECTLY FROM LINE EDIT WITHOUT REPLACING LINE
01500	DOEDIT←←100000	;REPLACE LINE BEFORE DISPATCHING FROM LINE EDIT
01600			;IF NEITHER OF THE ABOVE, RE-EDIT LINE AT SAME CURSOR POS (CHAR IS NO-OP)
01700	NOATT←←40000	;ILLEGAL IN ATTACH MODE
01800	NORDO←←20000	;ILLEGAL IF READ-ONLY
01900	;10000		;USER MODE BIT MUST BE UNUSED
02000	SACMD←←4000	;USES SEARCH ARG
02100	SSCMD←←2000	;SPECIAL ACTION WHEN ENTERED FROM SEARCH
02200	
02300	LPDESC←←3	;# EXTRA WDS DIR ENTRY
02400	DPBIT←←400000	;DIRPT ENTRY
02500	D1BIT←←200000	;DIRP1 ENTRY
02600	RPMASK←←77	;MASK FOR RELATIVE PAGE # FIELD
02700	RPBYTE←←<220600,,>	;BYTE PNTR FOR ABOVE
02800	
02900	LLDESC←←3		;# EXTRA WDS TEXT LINE
03000	PMARK←←400000		;THIS LINE IS A PAGE MARK
03100	ARRBIT←←200000		;LINE IS ARRLIN
03200	WINBIT←←100000		;LINE IS WINLIN
03300	PTRBIT←←040000		;LINE IS COMMENT OR REFERENCE POINTER
03400	
03500	LOKBIT←←200000	;LOCKS DOWN FS BLOCK (CAN'T BE SHUFFLED)
03600	
03700	MAXLIN←←=42
03800	ATTMAX←←8
     

00100	DD←←20000	;RUNNING ON DATA DISK
00200	III←←400000	;"	 "  III (BITS FROM GETLIN)
00300	SUPCCR←←2	;BREAK TABLE BIT TO SUPPRESS CTRL1-CR HACK
00400	DVDSK←←200000	;DISK BIT FROM DEVCHR
00500	MININT←←23	;LOWEST INT BIT #
00600	ADRSIZ←←17	;# BITS NEEDED TO ADDRESS PERMANENT CODE
00700	
00800	ZZ←←.
00900	LOC 137
01000	IFN PURESW,<
01100		JRST [	NOESS,<	MOVSI 'E  '>	;UPPER NAME ONCE SYSTEMIFIED
01200			ESSAY,<	MOVE ['ESSAY ']>
01300			SETNM2
01400			JRST 4,137
01500			MOVE P,[-LPDL+1,,PDL]	;Temp stack for checksum compute
01600			PUSHJ P,CHKUP		;Check upper segment before setpro
01700			MOVEM T,CHKSUM
01800			MOVNI 1
01900			SETUWP
02000			JRST 4,137
02100			MOVSI 155000
02200			SETPRO
02300			JRST 4,137
02400			CALLI 12]
02500	>
02600	
02700	IFG DEBSW-PURESW,<
02800		JRST [	JSP E,PURINI
02900			CALLI 12]
03000	>
03100	
03200	ORG ZZ
03300	
03400	FOR @! FOO IN(SORRY,FATAL)
03500	{DEFINE FOO(X)
03600	{	FOO!U [ASCIZ /X/]}
03700	}
     

00100	;GETCHR, FSFIX, TSTSHF, CW, LEG, UUOS, XOPDEF, PURE, IMPURE,
00200	
00300	DEFINE GETCHR(X)
00400	{ILDB C,INPNT
00500	SKIPGE X,CTAB(C)
00600	XCT @CTAB(C)}
00700	
00800	DEFINE GETCH1(X)
00900	{ILDB C,INPNT
01000	TDNE X,CTAB(C)
01100	XCT @CTAB(C)}
01200	
01300	DEFINE GETCH2(X,Y)
01400	{	ILDB C,Y
01500		TDNE X,CTAB(C)
01600		XCT @CTAB(C)}
01700	
01800	DEFINE FSFIX(X,Y)
01900	{	HRRI Y,(X)
02000		SUB Y,FSEND
02100	LEG	MOVEM Y,@FSEND
02200	LEG	HRRZM Y,-1(X)
02300		HRRZM X,FSEND}
02400	
02500	IFN DEBSW{DEFINE TSTSHF
02600	{	SKIPE SHFMOD
02700		PUSHJ P,MOVIT}}
02800	IFE DEBSW{DEFINE TSTSHF{}}
02900	
03000	DEFINE CW(C1,D1,C2,D2,C3,D3){BYTE(8)D1,D2,D3(3)C1,C2,C3,4}
03100	
03200	;THESE MACROS MAKE A LINKED LIST AROUND AND THROUGH
03300	;PURE AND UNPURE PARTS FOR CHECKSUMING THE PURE PARTS
03400	;AN ERROR WILL RESULT IF THE SAME MACRO IS CALLED
03500	;TWICE WITHOUT CALLING THE OTHER MACRO.
03600	%SEG←←0
03700	IFE PURESW{
03800		DEFINE PURE{IFN %SEG{!}	%SEG←←1	PURBEG←←.}
03900		DEFINE IMPURE{IFE %SEG{!}	%SEG←←0
04000			PURBEG,,PURLK2↔PURLK2←←.-1
04100			PURBEG,,PURLNK↔PURLNK←←.-1}
04200	PURLNK←←PURLK2←←0}
04300	
04400	
04500	;THESE MACROS SET RELOCATION TO THE PROPER SEGMENT FOR PURE OR UNPURE CODE
04600	;AN ERROR MESSAGE WILL RESULT IF THE SAME MACRO IS CALLED TWICE WITHOUT
04700	;CALLING THE OTHER MACRO.
04800	IFN PURESW{
04900		TWOSEG
05000		RELOC 400000
05100		RELOC
05200		DEFINE PURE{IFN %SEG{!}	%SEG←←1	RELOC}
05300		DEFINE IMPURE{IFE %SEG{!}	%SEG←←0	RELOC}}
05400	
05500	
05600	;THIS MACRO SHOULD PRECEDE A LINE OF CODE WHICH CAN
05700	;GENERATE A LEGAL ILL MEM REF.
05800	LEGNUM←←0
05900	DEFINE LEG{FOR @! X←LEGNUM,LEGNUM{LEG!X←←.}	LEGNUM←←LEGNUM+1
06000	}
06100	
06200	
06300	DEFINE UUOS{FOR @! X IN(TYPCHR,TYPDEC,TYPOCT,SORRYU,FATALU,XTTYUU,SNEAKW,SNEAKS)}
06400	
06500	ZZ←←0
06600	UUOS{ZZ←←ZZ+1
06700	OPDEF X[ZZ⊗33]
06800	}
06900	
07000	DEFINE XOPDEF(X,AC){OPDEF X[XTTYUU AC,]}
07100	FOR X ⊂ ({INCHRW,0},{INCHRS,2},{INCHWL,4},{INCHSL,5})
07200		{XOPDEF ( X ) ↔ }
07300	NUUOS←←ZZ+1
07400	
07500	EXTERN JOBREL,JOBFF,JOBAPR,JOBTPC,JOBDDT,JOBREN,JOBOPC,JOBCNI
07600	PURE
07700	
     

00100	;BEG, BEGSYS, BEGACT, BEGRPT, BEGDBG
00200	
00300	IFN DEBSW,<JRST BEGDBG>
00400		JRST BEGRPT
00500	BEG:	JRST BEG0				;RUN OR ET COMMAND
00600		JRST BEGRPG				;RPG START. AC'S CONTAIN PARAMS
00700		MOVEM 16,EPDL				;SYSTEM AXXCOM START
00800		MOVEM 17,EPDL2				;17[SIXBIT COMMAND, 16[ASCII DELIM
00900		JSP P,INIT				;INITIALIZE
01000		MOVE T,EPDL2				;GET COMMAND NAME
01100		MOVEM T,SYSCMD				;STOW IT
01200		MOVE A,[440700,,BUF]			;INITIAL BYTE POINTER
01300		MOVE C,EPDL				;INITIAL CHARACTER IN "SCAN"
01400	;	PUSHJ P,TYIT
01500	;	JRST BEGACT
01600	;	SETACT [BRKTAB,,BRKTAB]		;APPARENT NO OP -- RPH
01700		INWAIT
01800		HRLOI T,377777				;SET T INFINITE
01900		PUSHJ P,RSCN4A				;SCAN REMAINER OF COMMAND FOR ARGS
02000	BEGSYS:	LDB C,[301400,,SYSCMD]			;GET 2 CHARACTERS OF COMMAND NAME
02100		PUSHJ P,SYSCCK				;DO WE KNOW THEM
02200		JRST BEG1				;YES. NOW WE READ FILE NAME FROM TTY
02300		JRST BEG0				;DONT UNDERSTAND COMMAND. RESCAN.
02400	
02500	BEGACT:	MOVE T,[440700,,[ASCIZ /
02600	/]]
02700		MOVEM T,TYIPNT
02800		JRST BEGSYS
02900	
03000	BEGRPT:	JSP P,INIT			;INITIALIZE
03100		PUSHJ P,TMPRED			;TRY TO READ TMPCORE FILE
03200		JRST BEG0A
03300		PUSH P,TYIPNT			;SAVE POINTER TO ARGS
03400		MOVEM G,TYIPNT			;POINT TO COMMAND
03500		PUSHJ P,GETNAM			;AND READ IT
03600		MOVEM A,SYSCMD
03700		POP P,TYIPNT			;NOW POINT TO ARGS AGAIN
03800		JRST BEGSYS			;AND LOOK LIKE AXXCOM STARTUP
03900	
04000	IFN DEBSW,<
04100	BEGDBG:	JSP P,INIT			;HERE FOR DEBUGGING. INITIALIZE
04200		INWAIT				;WAIT FOR SOMETHING TO BE TYPED
04300		HRLOI T,377777			;SET CHARACTER COUNT TO INFINITE
04400		PUSHJ P,RSCAN0			;READ COMMAND, AVOID RESCAN
04500		JRST BEG0A			;ACT NORMAL
04600	>
     

00100	;BEGRPG
00200	;HERE AT RPG STARTUP.
00300	
00400	BEGRPG:	MOVEM 17,RPGACS+17
00500		MOVEI 17,RPGACS
00600		BLT 17,RPGACS+16		;SAVE RPG PARAMETERS
00700		JSP P,INIT0			;INITIALIZE
00800		HRRZ T,RPGLIN
00900		CAILE T,=999
01000		SETZB T,RPGLIN
01100		MOVEM T,SLINE			;STARTING LINE NUMBER
01200		SKIPGE T,RPGPAG
01300		MOVEI T,
01400		MOVEM T,SPAGE			;STARTING PAGE NUMBER
01500		MOVSI T,'DSK'
01600		MOVEM T,EDFIL-1			;DEFAULT DEVICE
01700		SKIPN T,RPGFIL
01800		JRST GETOU1			;NO FILE NAME - NO EDIT.  EXIT
01900		MOVEM T,EDFIL			;SAVE EDIT FILE NAME
02000		SKIPN T,RPGPPN
02100		MOVE T,PPN
02200		MOVEM T,EDFIL+3			;EDIT FILE PPN
02300		MOVE T,RPGEXT
02400		HLLZM T,EDFIL+1			;EDIT FILE EXT
02500		SETZM EDFIL+2
02600		SETZM EDFIL+4
02700		HRLOI TT,1
02800		TRNE T,100000			;INSPECT MODE FLAGS
02900		MOVEM TT,EDFIL+4		;SET /N  NO DIRECTORY
03000		TRNE T,400000
03100		SETOM CREASW			;CREATING
03200		TRNE T,200000
03300		SETOM RDONLY			;/R READONLY
03400		PUSHJ P,ZLIST			;SAVE ALL THIS SHINY NEW DATA IN ZDATA
03500		JRST BEG3
03600	
03700	IMPURE
03800	RPGACS:	BLOCK 11			;PLACE TO SAVE RPG PARAMETERS
03900	RPGPPN:	0
04000		0
04100	RPGEXT:	0
04200	RPGFIL:	0
04300	RPGLIN:	0
04400	RPGPAG:	0
04500		0
04600	PURE
     

00100	;BEG0, BEG1, BEG1A, BEG2, BEGBKP
00200	
00300	BEG0:	JSP P,INIT			;INITIALIZE
00400	BEG0.1:	PUSHJ P,RSCAN			;RESCAN TTY
00500	BEG0A:	SKIPN TYIPNT			;WAS THERE ANYTHING THERE?
00600		OUTSTR [ASCIZ /
00700	FILE? /]		;NO. ASK FOR SOME.
00800	BEG1:	MOVEI D,EDFIL			;POINTER TO DEPOSIT?
00900		LDB C,[301400,,SYSCMD]		;GET THE COMMAND NAME
01000		PUSHJ P,CRECHK			;WAS IT CREATE?
01100		JRST [SETOM CREASW		;YES. SET FLAG
01200			JRST BEGSY2]	
01300	IFN BOOKMD, {
01400		CAIN C,'RE'			;"READ" COMMAND?
01500		JRST BEGBKP			;YES
01600	};END BOOKMD
01700		JUMPN C,BEGSY1			;WAS IT SOME SORT OF COMMAND AT ALL?
01800	BEGSY2:	PUSHJ P,FRD			;READ FILE NAME (TTY OR RESCANNED DATA)
01900		JRST FNERR			;OOPS.
02000	BEGSY3:	SKIPN EDFIL
02100		JRST GETOU1
02200		HLLM D,SRCFIL
02300		HLLM D,DSTFIL
02400	IFN BOOKMD, {
02500		SKIPN BKPSW		;"READ" COMMAND USED?
02600		JRST BEGSY4		;NO
02700		PUSH P,C
02800		PUSHJ P,BKPRED		;LOOK FOR <FILENM>.BKP FILE (LIKE RPG FILE)
02900		POP P,C
03000		SETOM BOOKSW		;BKPSW IMPLIES BOOKSW
03100		SETOM RDONLY		;BOOKSW IMPLIES RDONLY
03200		JRST BEG1A
03300	BEGSY4:
03400	};END BOOKMD
03500		TLNN D,740		;ANY FILENAME, EXTENSION, OR PPN SPECIFIED?
03600		JRST BEG1B		;NO
03700		MOVEI G,(C)
03800		PUSHJ P,TMPWRT
03900		LDB C,[301400,,SYSCMD]
04000		PUSHJ P,CRECHK
04100		SETOM CREASW
04200		MOVEI C,(G)
04300	BEG1B:	CAIE C,"←"
04400		CAIN C,"→"
04500		TROA F,COPY
04600		JRST BEG1A
04700		MOVEM C,TRMCHR#
04800		MOVEI D,EDFIL2
04900		PUSHJ P,FRD
05000		JRST FNERR
05100		MOVE G,[,SRCFIL-EDFIL2(A)]
05200		CAIN C,"→"
05300		HRRI G,DSTFIL-EDFIL2
05400		MOVE A,[-5,,EDFIL2]
05500		HRRZM A,@G
05600		AOBJN A,.-1
05700		HLLM D,EDFIL2(G)
05800		SKIPN @SRCFIL
05900		SETOM CREASW
06000	BEG1A:	PUSHJ P,TYIT
06100		JRST BEG3
06200	BEG2:	PUSHJ P,TYI
06300		JRST BEG3
06400		JRST BEG2
06500	
06600	FLOSE:	SUB P,[1,,1]
06700	FNERR:	OUTSTR [ASCIZ /ILLEGAL FILE SPECIFICATION./]
06800		JRST FNF1
06900	
07000	IFN BOOKMD, {
07100	BEGBKP:	SETOM BKPSW#	;BKPSW MEANS WE WERE STARTED BY "READ" CMD TO USE .BKP FILE
07200		SETOM BOOKSW#	;BOOKSW MEANS WE ARE IN /B MODE--NO FILE MODIFYING ALLOWED
07300	};END BOOKMD
07400	BEGSY1:	MOVE H,TYIPNT
07500		SKIPN TCPNT
07600		PUSHJ P,TMPRED
07700		JRST BEGSY2
07800		PUSHJ P,FRD
07900		JFCL
08000		MOVEM H,TYIPNT
08100		HRLI D,200000
08200		PUSHJ P,FRD0
08300		JRST FNERR
08400		JRST BEGSY3
     

00100	;BEG3,BEG4
00200	
00300	BEG3:	PUSHJ P,SNKON
00400		PUSHJ P,DPYSKI
00500		SKIPE CREASW
00600		PUSHJ P,CREATE
00700	BEG4:	MOVEI D,@SRCFIL
00800		MOVEI A,1
00900		PUSHJ P,OPENI
01000		JRST FNF
01100		MOVE T,@SRCFIL+4
01200		AOS SRCFIL+4
01300		MOVEM T,@SRCFIL+4
01400		SKIPN DIR
01500		PUSHJ P,GETDIR
01600		MOVE T,EDFIL+4
01700		TRNN F,COPY
01800		IOR T,@SRCFIL+4
01900		ADDI T,1
02000		HRRZM T,DIRPAG#
02100		PUSHJ P,COPFIL
02200		MOVEI D,EDFIL
02300		MOVEI A,1
02400		PUSHJ P,OPNOI
02500		PUSHJ P,OPNLUZ
02600		TRZE F,UPDTXT
02700		PUSHJ P,OUTDIR	;GETDIR ASKING FOR WRITE
02800		MOVE A,[ASCID /  /]
02900		MOVEM A,HEDNAM
03000		HRRZM A,HEDNAM+1
03100		MOVE A,[HEDNAM+1,,HEDNAM+2]
03200		BLT A,ROFLG-1
03300		MOVE A,[260700,,HEDNAM]
03400		MOVEM A,TYOPNT
03500		MOVEI D,EDFIL
03600		PUSHJ P,FILSTR
03700		MOVEI A,<BYTE(7),,,"/","R"(1)1>
03800		SKIPE RDONLY
03900		TROA F,REDNLY
04000		MOVEI A,1
04100	IFN BOOKMD, {
04200		SKIPE BOOKSW
04300		MOVEI A,<BYTE(7),,,"/","B"(1)1>
04400	};END BOOKMD
04500		MOVEM A,ROFLG
04600		MOVE A,[HEDNAM,,HED2NM]
04700		BLT A,ROFLG2
04800		MOVE T,PAGES
04900		CAIE T,2
05000		MOVEI T,1
05100		SKIPGE A,SPAGE	;FIRST PAGE TO LOOK AT
05200		MOVEI A,-1(T)	;NONE - ASSUME DIR
05300		ADD A,DIRPAG
05400		JUMPG A,.+2
05500		MOVEI A,1
05600		PUSHJ P,RDPAGE
05700		JFCL
05800		SKIPE MARKS		;Are there any line marks
05900		PUSHJ P,XMPAGE		;Yes, so get last mark on page data
06000		TRNE F,REDNLY!DIROK
06100		JRST .+3
06200		TRO F,COPY
06300		JRST BEG4
06400		SETZM TYIPNT
06500		PUSHJ P,DPYINI
06600		PUSHJ P,PGINIT
06700		PUSHJ P,TMPWRT
06800	IFN BOOKMD, {
06900		SKIPGE A,NEWBKP
07000		OUTSTR [ASCIZ /WILL CREATE .BKP FILE
07100	/]
07200	};END BOOKMD
07300		HLRZ A,RPGLIN
07400		TRNE A,376000
07500		JRST MAIN
07600		TRZN A,400000
07700		JUMPG A,[MOVEM A,EDMOV↔MOVE D,CMDSP-1↔MOVEI A,↔JRST MAIN2]
07800		TLNN F,ZATT		;To preserve ATTACH status if necessary
07900		PUSHJ P,ATTACH
08000		JFCL